library(imputeTS)
library(lubridate)
library(xts)
library(zoo)
library(tseries)
library(stats)
library(forecast)
library(astsa)
library(corrplot)
library(wordcloud)
library(tidytext)
library(AER)
library(vars)
library(dynlm)
library(mFilter)
library(TSstudio)
library(tidyverse)
library(sarima)
library(readr)
library(readxl)
library(patchwork)
library(heatmaply)
library(dplyr)
library(ggplot2)
library(psych)
library(tidyr)
library(readtext)
library(syuzhet)
library(RColorBrewer)
library(tm)
library(caret)
library(MASS)
library(rpart)
library(rpart.plot)
library(party)
library(gmodels)
library(knitr)
library(cluster)
library(e1071)
library(janeaustenr)
library(pROC)
library(ISLR)
library(gridExtra)
library(car)
library(DataExplorer)
library(randomForest)
library(class)
library(factoextra)
library(purrr)
library(reshape2)
library(tmap)
library(sf)
library(zoo)
setwd("../databases")
form_satisfaccion <- read_excel("form/Encuesta_Datos_FORM_Fall2023.xlsx")
form_bajas = read_xlsx("form/temporary/BDD_FORM_BAJAS-2023.xlsx")
cp_nl <- st_read("geo_reference__nl/CP_NL")
## Reading layer `CP_19NL_v10' from data source
## `/Users/daviddrums180/Tec/Case_Study_Form/databases/geo_reference__nl/CP_NL'
## using driver `ESRI Shapefile'
## Simple feature collection with 1338 features and 1 field
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: 2578831 ymin: 1238179 xmax: 2858006 ymax: 1749577
## Projected CRS: Lambert_Conformal_Conic
exp_vehiculos = read_csv("industry_autos_mx/exportacion_vehiculos_mx.csv")
ventas_vehiculos = read_csv("industry_autos_mx/mx_venta_vehiculos.csv")
exp_vehiculos_total = read_excel("industry_autos_mx/exportacion_vehiculos.xlsx")
# Limpieza de Fecha
form_bajas$`Fecha de Nacimiento` <- as.Date(form_bajas$`Fecha de Nacimiento` - ifelse(form_bajas$`Fecha de Nacimiento` > 60, 1, 0), origin="1899-12-30")
form_bajas$`Fecha de Alta` <- as.Date(form_bajas$`Fecha de Alta` - ifelse(form_bajas$`Fecha de Alta` > 60, 1, 0), origin="1899-12-30")
form_bajas$`Primer Mes` <- as.Date(form_bajas$`Primer Mes` - ifelse(form_bajas$`Primer Mes` > 60, 1, 0), origin="1899-12-30")
form_bajas$`Cuarto Mes` <- as.Date(form_bajas$`Cuarto Mes` - ifelse(form_bajas$`Cuarto Mes` > 60, 1, 0), origin="1899-12-30")
form_bajas$`Fecha de Baja` <- as.Date(form_bajas$`Fecha de Baja` - ifelse(form_bajas$`Fecha de Baja` > 60, 1, 0), origin="1899-12-30")
# Calcular la antigüedad como la diferencia entre Fecha de Baja y Fecha de Alta
form_bajas$Antiguedad <- abs(as.numeric(form_bajas$`Fecha de Baja` - form_bajas$`Fecha de Alta`, units = "days"))
head(form_bajas)
## # A tibble: 6 × 27
## No. Apellidos Nombre `Fecha de Nacimiento` Género RFC `Fecha de Alta`
## <dbl> <chr> <chr> <date> <chr> <chr> <date>
## 1 1 Perez Chavarr… Yessi… 1985-02-12 Femen… PECY… 2022-09-04
## 2 1 Pecina Aleman Blanc… 1966-05-24 Femen… PEAB… 2022-10-05
## 3 1 Suarez Romo Julio… 1969-06-26 Mascu… SURJ… 2017-11-30
## 4 1 Ortiz De La T… Fermi… 1966-07-06 Femen… OITF… 2022-05-31
## 5 1 Gallegos Manz… Veron… 1973-11-27 Femen… GAMV… 2022-10-21
## 6 1 Guzman Reyes Carlo… 2002-11-24 Mascu… GURC… 2023-01-05
## # ℹ 20 more variables: `Primer Mes` <date>, `Cuarto Mes` <date>,
## # `Fecha de Baja` <date>, `Motivo de Baja` <chr>, Puesto <chr>, Dpto <chr>,
## # Imss <chr>, SD <chr>, `Factor de Crédito Infonavit` <chr>,
## # `No. De Crédito Infonavit` <chr>, CURP <chr>, Calle <chr>, Número <chr>,
## # Colonia <chr>, Municipio <chr>, Estado <chr>, CP <dbl>,
## # `Estado Civil` <chr>, `Número de Télefono` <dbl>, Antiguedad <dbl>
form_bajas$CP <- as.character(form_bajas$CP)
cp_nl$d_codigo <- as.character(cp_nl$d_codigo)
stats_por_cp <- form_bajas %>%
group_by(CP) %>%
summarize(
Conteo_Empleados = n(),
Mediana_Antiguedad = median(Antiguedad, na.rm = TRUE),
.groups = 'drop'
)
form_bajas_espacial <- cp_nl %>%
left_join(stats_por_cp, by = c("d_codigo" = "CP"))
# Reemplazar NA con 0 en las columnas de interés
form_bajas_espacial$Conteo_Empleados[is.na(form_bajas_espacial$Conteo_Empleados)] <- 0
form_bajas_espacial$Mediana_Antiguedad[is.na(form_bajas_espacial$Mediana_Antiguedad)] <- 0
head(form_bajas_espacial)
## Simple feature collection with 6 features and 3 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: 2661927 ymin: 1481451 xmax: 2725620 ymax: 1529424
## Projected CRS: Lambert_Conformal_Conic
## d_codigo Conteo_Empleados Mediana_Antiguedad geometry
## 1 66063 0 0 MULTIPOLYGON (((2662011 152...
## 2 67495 0 0 MULTIPOLYGON (((2716586 149...
## 3 67467 0 0 MULTIPOLYGON (((2707035 148...
## 4 67494 0 0 MULTIPOLYGON (((2718640 149...
## 5 67475 0 0 MULTIPOLYGON (((2707164 151...
## 6 64010 0 0 MULTIPOLYGON (((2670043 151...
# Lista de columnas específicas a transformar
columnas_a_transformar <- c("salario_bueno", "prestaciones_bueno", "jornada_no_excesiva",
"ofrecimiento_herramientas", "no_molestia_temperatura", "estres_bajo",
"facilidad_transporte", "zona_trabajo_comoda", "permanencia_form_futuro")
# Ajustar la función para manejar el typo y valores inesperados
codificar_respuestas <- function(respuesta) {
# Corregir posibles typos
respuesta <- gsub("Totalmende en desacuerdo", "Totalmente en desacuerdo", respuesta)
# Usar switch para asignar valores numéricos
switch(respuesta,
"Totalmente en desacuerdo" = 1,
"Medianamente en desacuerdo" = 2,
"Ni de acuerdo ni en desacuerdo" = 3,
"Medianamente de acuerdo" = 4,
"Totalmente de acuerdo" = 5,
NA) # Devolver NA para cualquier respuesta no reconocida
}
# Aplicar la codificación solo a las columnas seleccionadas, asegurando que todas las transformaciones son numéricas
form_satisfaccion[columnas_a_transformar] <- lapply(form_satisfaccion[columnas_a_transformar], function(x) as.numeric(sapply(x, codificar_respuestas)))
head(form_satisfaccion)
## # A tibble: 6 × 22
## encuesta puesto antiguedad razon_entrada salario_bueno prestaciones_bueno
## <dbl> <chr> <dbl> <chr> <dbl> <dbl>
## 1 1 administra… 9 salario 5 4
## 2 2 costurera 36 otro 4 4
## 3 3 ayudante g… 4 ubicacion em… 2 1
## 4 4 ayudante g… 2 ubicacion em… 5 4
## 5 5 ayudante g… 1 ubicacion em… 3 1
## 6 6 ayudante g… 36 razones pers… 4 5
## # ℹ 16 more variables: jornada_no_excesiva <dbl>,
## # ofrecimiento_herramientas <dbl>, no_molestia_temperatura <dbl>,
## # estres_bajo <dbl>, facilidad_transporte <dbl>, zona_trabajo_comoda <dbl>,
## # permanencia_form_futuro <dbl>, sufrido_situaciones_conflicto <chr>,
## # molestias_puesto <chr>, sentimiento_form <chr>, edad <chr>, genero <chr>,
## # estado_civil <chr>, municipio <chr>, nivel_escolar <chr>,
## # personas_dependientes <dbl>
exp_vehiculos$Fecha <- as.yearqtr(exp_vehiculos$quarter, format = "%Y-Q%q")
ventas_vehiculos$Fecha <- as.yearqtr(paste(ventas_vehiculos$ANIO, ventas_vehiculos$ID_MES, "1"), format = "%Y %m %d")
# Generar los datos para la variable 'no_molestia_temperatura'
datos_temperatura <- form_satisfaccion %>%
group_by(no_molestia_temperatura) %>%
summarise(Count = n()) %>%
mutate(Percentage = Count / sum(Count) * 100)
# Paleta de colores personalizada: rojo, dorado, verde
colores_personalizados <- c("#d7191c", "#fdae61", "#ffffbf", "#a6d96a", "#1a9641")
# Gráfico de barras para 'no_molestia_temperatura'
ggplot(datos_temperatura, aes(x = factor(no_molestia_temperatura, levels = c(1, 2, 3, 4, 5)), y = Percentage, fill = as.factor(no_molestia_temperatura))) +
geom_bar(stat = "identity") +
scale_fill_manual(values = colores_personalizados) +
scale_x_discrete(labels = c("Totalmente\nen desacuerdo", "Medianamente\nen desacuerdo", "Ni de acuerdo\nni en desacuerdo", "Medianamente\nde acuerdo", "Totalmente\nde acuerdo")) +
xlab("Nivel de Acuerdo con la Temperatura") +
ylab("Porcentaje") +
ggtitle("Distribución de Respuestas para 'No Molestia por la Temperatura'") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 0, hjust = 0.5, size = 8),
legend.title = element_blank(),
legend.position = "bottom")
variables_categoricas <- c("salario_bueno", "prestaciones_bueno", "jornada_no_excesiva",
"ofrecimiento_herramientas", "no_molestia_temperatura", "estres_bajo",
"facilidad_transporte", "zona_trabajo_comoda", "permanencia_form_futuro")
# Calculamos los porcentajes por categoría para cada variable
porcentajes_categorias <- form_satisfaccion %>%
select(all_of(variables_categoricas)) %>%
pivot_longer(cols = everything(), names_to = "Variable", values_to = "Valor") %>%
group_by(Variable) %>%
count(Valor) %>%
mutate(Porcentaje = n / sum(n) * 100) %>%
ungroup() %>%
select(-n) # Si no necesitas la columna de conteos, puedes omitirla.
# Convertir a un formato ancho específico para cada variable y valor
porcentajes_ancho <- porcentajes_categorias %>%
pivot_wider(names_from = Valor, values_from = Porcentaje, names_prefix = "Categoria_") %>%
select(Variable, starts_with("Categoria_")) %>%
arrange(Variable)
# Modificamos 'porcentajes_ancho' para formatear los porcentajes
porcentajes_ancho <- porcentajes_ancho %>%
mutate(across(starts_with("Categoria_"), ~sprintf("%.1f%%", .)))
# Ver los resultados
print(porcentajes_ancho)
## # A tibble: 9 × 6
## Variable Categoria_1 Categoria_2 Categoria_3 Categoria_4 Categoria_5
## <chr> <chr> <chr> <chr> <chr> <chr>
## 1 estres_bajo 12.3% 8.5% 18.9% 19.8% 40.6%
## 2 facilidad_transpo… 14.2% 8.5% 1.9% 13.2% 62.3%
## 3 jornada_no_excesi… 7.5% 5.7% 9.4% 17.9% 59.4%
## 4 no_molestia_tempe… 33.0% 6.6% 11.3% 13.2% 35.8%
## 5 ofrecimiento_herr… 18.9% 1.9% 8.5% 14.2% 56.6%
## 6 permanencia_form_… 8.5% 4.7% 14.2% 19.8% 52.8%
## 7 prestaciones_bueno 19.8% 17.9% 9.4% 20.8% 32.1%
## 8 salario_bueno 10.4% 10.4% 7.5% 33.0% 38.7%
## 9 zona_trabajo_como… 7.5% 4.7% 3.8% 17.0% 67.0%
# Agregar una columna que indique el mes de la fecha de baja
form_bajas$Mes <- month(form_bajas$`Fecha de Baja`)
form_bajas$Año <- year(form_bajas$`Fecha de Baja`)
# Agrupar por mes y género, luego contar las bajas
bajas_por_mes_genero <- form_bajas %>%
group_by(Mes, Género) %>%
summarise(Conteo = n(), .groups = 'drop') %>%
arrange(Mes)
# Graficar las bajas por mes para cada género
ggplot(bajas_por_mes_genero, aes(x = Mes, y = Conteo, group = Género, color = Género)) +
geom_line() +
scale_x_continuous(breaks = 1:12, labels = month.name) +
theme_minimal() +
labs(title = "Bajas por Mes Dividido por Género",
x = "Mes",
y = "Número de Bajas",
color = "Género")
# Configurar tmap para que intente reparar automáticamente los polígonos inválidos
tmap_options(check.and.fix = TRUE)
# Calcular los breaks para Conteo de Empleados excluyendo los ceros
conteo_empleados_values <- form_bajas_espacial$Conteo_Empleados[form_bajas_espacial$Conteo_Empleados > 0]
breaks_conteo <- c(-Inf, quantile(conteo_empleados_values, probs = seq(0, 1, by = 0.25), na.rm = TRUE))
# Calcular los breaks para Mediana de Antigüedad excluyendo los ceros
antiguedad_values <- form_bajas_espacial$Mediana_Antiguedad[form_bajas_espacial$Mediana_Antiguedad > 0]
breaks_antiguedad <- c(-Inf, quantile(antiguedad_values, probs = seq(0, 1, by = 0.25), na.rm = TRUE))
# Mapa para Conteo de Empleados
conteo_empleados_map <- tm_shape(form_bajas_espacial) +
tm_fill("Conteo_Empleados", palette = "Blues", style = "fixed", breaks = breaks_conteo,
title = "Conteo de Empleados", na.color = "white") +
tm_borders() +
tm_layout(frame = FALSE, legend.position = c("left", "bottom"))
# Mapa para Mediana de Antigüedad
mediana_antiguedad_map <- tm_shape(form_bajas_espacial) +
tm_fill("Mediana_Antiguedad", palette = "BuPu", style = "fixed", breaks = breaks_antiguedad,
title = "Mediana de Antigüedad", na.color = "white") +
tm_borders() +
tm_layout(frame = FALSE, legend.position = c("right", "bottom"))
# Configurar opciones de tmap para la visualización de los mapas
tmap_mode("view")
# Mostrar mapas lado a lado
tmap_arrange(conteo_empleados_map, mediana_antiguedad_map, nrow = 1)